home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / PASCAL / MISC_ROU / STRINGFU.P < prev   
Text File  |  1990-07-05  |  9KB  |  289 lines
  1. {    StringFunctions Unit                                                                            }
  2. {    By: Jon Wind                                                                                    }
  3. {    CIS: [70167,3444]        GENIE: JPWIND        AMERICA ONLINE: JWIND                }
  4. {                                                                                                    }
  5. {    This DA shell was written in THINK's Lightspeed Pascal¬ v3.01.                        }
  6. {                                                                                                    }
  7. {    Intro.                                                                                            }
  8. {    -----                                                                                            }
  9. {    I wrote this unit to provide an easy means of manipulating 'STR ' and 'STR#'            }
  10. {    resources which are stored in an application's resource fork.                            }
  11. {                                                                                                    }
  12. {    This unit is free and may be used however you like.  But please do not redistribute    }
  13. {    modified copies without my permission!                                                    }
  14. {                                                                                                    }
  15. {    Usage                                                                                            }
  16. {    ------                                                                                            }
  17. {                                                                                                    }
  18. {    Most of the procedures in this unit are functions, but they could be easily modified    }
  19. {    to work as procedures if you'd rather not deal with returned values.                    }
  20. {                                                                                                    }
  21. {    Call CreateEmptyStr to create a new, empty 'STR ' or 'STR#' resource.  Then     call    }
  22. {    SetIndString to store a new entry into a 'STR#' resource, or SetStr to store a new    }
  23. {    string into a 'STR ' resource.                                                                }
  24. {                                                                                                    }
  25. {    Call GetIndStr to get a 'STR#' entry or call GetStr to get a 'STR ' entry.  Call            }
  26. {    GetTotalStr to get the total number of entries in a 'STR#' resource.                    }
  27. {                                                                                                    }
  28. {    Call aNum2Str, aStr2Num, Replace, ReplaceAll, Lower, and CapitalizeWords to         }
  29. {    perform some more handy string processing.                                                }
  30. {                                                                                                    }
  31. {    Updates                                                                                        }
  32. {    -------                                                                                        }
  33. {                                                                                                    }
  34. {    7/5/90    :    Added a few more comments, removed a DisposHandle that wasn't        }
  35. {                    needed, and added HNoPurge and HPurge lines.                                }
  36. {                                                                                                    }
  37. {                                                                                                    }
  38. unit StringFunctions;
  39.  
  40.  
  41.  
  42. interface
  43.  
  44.  
  45.     function GetTotalStr (theID: Integer): Integer;
  46. {get total number of strings in 'STR#' resource - returns resNotFound if resource not found}
  47.  
  48.     function GetIndStr (theID, index: Integer): Str255;
  49. { GetIndString available as a function }
  50.  
  51.     function GetStr (theID: Integer): Str255;
  52. { GetString available as a function }
  53.  
  54.     function SetIndString (theID, index: Integer; newStr: Str255): OSErr;
  55. { Set 'STR#' resource entry to a specific string }
  56.  
  57.     function SetStr (theID: Integer; newStr: Str255): OSErr;
  58. { Set 'STR ' resource to a specific string }
  59.  
  60.     function CreateEmptyStr (theType: ResType; theID: Integer): OSErr;
  61. { create new, empty 'STR#' or 'STR ' resource - returns result from AddResource }
  62.  
  63.     function aNum2Str (aNum: LongInt): Str255;
  64. { converts a number to a string - NumToString available as a function }
  65.  
  66.     function aStr2Num (NumStr: Str255): LongInt;
  67. { converts a string to a number - StringToNum available as a function }
  68. { Note: won't accurately return numbers if letters are in NumStr }
  69.  
  70.     procedure Replace (var strvar: Str255; oldstr, newstr: Str255);
  71. { replace or delete a portion of a string }
  72.  
  73.     procedure ReplaceAll (var strvar: Str255; oldstr, newstr: Str255);
  74. { replace or delete all occurances of oldstr in string Var }
  75.  
  76.     procedure Lower (var strvar: str255);
  77. { convert a string to lower case including those w/ diacritical marks }
  78.  
  79.     procedure CapitalizeWords (var strvar: str255);
  80. { attempts to capitalize words in a string }
  81.  
  82.  
  83.  
  84. implementation
  85.  
  86.  
  87.  
  88.     function GetTotalStr;{ (theID: Integer): Integer}
  89.         var
  90.             thePtr: ^Integer;
  91.             Hndl: Handle;
  92.     begin
  93.         Hndl := GetResource('STR#', theID);            { use Get1Resource to limit search to current resource fork }
  94.         if Hndl <> nil then
  95.             begin
  96.                 thePtr := Pointer(ord4(hndl^));
  97.                 GetTotalStr := thePtr^;
  98.                 ReleaseResource(Hndl);
  99.             end
  100.         else
  101.             GetTotalStr := resNotFound;
  102.     end;  { of func GetTotalStr }
  103.  
  104.  
  105.     function GetIndStr; {(theID, index: Integer): Str255}
  106.         var
  107.             theString: Str255;
  108.     begin
  109.         GetIndString(theString, theID, index);
  110.         GetIndStr := theString;
  111.     end;  { of func GetIndStr }
  112.  
  113.  
  114.     function GetStr;{ (theID: Integer): Str255}
  115.         var
  116.             S1: StringHandle;
  117.     begin
  118.         S1 := GetString(theID);
  119.         GetStr := S1^^;
  120.     end;  { of func GetStr }
  121.  
  122.  
  123.     function SetIndString; {(theID, index: Integer; newStr: Str255): OSErr}
  124.         var
  125.             offset, place: LongInt;
  126.             Hndl: Handle;
  127.             TotalStrings: ^Integer;
  128.             i, theError: Integer;
  129.             EmptyCh: char;
  130.     begin
  131.         EmptyCh := char(0);
  132.         Hndl := GetResource('STR#', theID);            { use Get1Resource to limit search to current resource fork }
  133.         if Hndl <> nil then
  134.             begin
  135.                 HNoPurge(Hndl);
  136.                 TotalStrings := Pointer(ord4(hndl^));
  137.                 if index > TotalStrings^ then            { append string(s) }
  138.                     begin
  139.                         for i := Succ(TotalStrings^) to Pred(index) do
  140.                             place := PtrAndHand(Pointer(Ord4(@EmptyCh) + 1), Hndl, 1);        { append nul to STR# }
  141.                         place := PtrAndHand(Pointer(Ord4(@newStr)), Hndl, Succ(Length(newStr)));    { append string to STR# }
  142.                         TotalStrings^ := index;            { set number of strings to reflect addition(s) }
  143.                     end
  144.                 else            { replace existing string with new string }
  145.                     begin
  146.                         offset := 2;
  147.                         for i := 1 to Pred(index) do        { get character offset of specified 'STR#' entry }
  148.                             offset := offset + Succ(Length(GetIndStr(theID, i)));
  149.                         place := Munger(Hndl, offset, nil, Succ(Length(GetIndStr(theID, index))), Pointer(Ord4(@newStr)), Succ(Length(newStr)));
  150.                     end;
  151.                 ChangedResource(Hndl);
  152.                 theError := ResError;
  153.                 if theError = noErr then
  154.                     WriteResource(Hndl);
  155.                 HPurge(Hndl);
  156.                 ReleaseResource(Hndl);
  157.             end
  158.         else
  159.             theError := resNotFound;
  160.         SetIndString := theError;
  161.     end; {of func SetIndString}
  162.  
  163.  
  164.     function SetStr;{ (theID: Integer; newStr: Str255):OSErr}
  165.         var
  166.             S1: StringHandle;
  167.             theError: Integer;
  168.     begin
  169.         S1 := GetString(theID);
  170.         if Handle(S1) <> nil then
  171.             begin
  172.                 SetString(S1, newStr);
  173.                 ChangedResource(Handle(S1));
  174.                 theError := ResError;
  175.                 if theError = noErr then
  176.                     WriteResource(Handle(S1));
  177.             end
  178.         else
  179.             theError := resNotFound;
  180.         SetStr := theError;
  181.     end;  { of proc SetStr }
  182.  
  183.  
  184.     function CreateEmptyStr; {(theType: ResType; theID: Integer): OSErr}
  185.         var
  186.             Hndl: Handle;
  187.             Amt, theError, Zero: Integer;
  188.     begin
  189.         Zero := 0;
  190.         if theType = 'STR#' then    { pass any other type to create a resource containing a single zero }
  191.             Amt := 2
  192.         else
  193.             Amt := 1;
  194.         Zero := PtrToHand(Pointer(Ord(@Zero)), Hndl, Amt);
  195.         AddResource(Hndl, theType, theID, '');
  196.         theError := ResError;
  197.         if theError = noErr then
  198.             WriteResource(Hndl);
  199.         CreateEmptyStr := theError;
  200.     end;  { of proc CreateEmptyStr }
  201.  
  202.  
  203.     function aNum2Str;{(aNum: LongInt): Str255}
  204.         var
  205.             NumStr: Str255;
  206.     begin
  207.         NumToString(aNum, NumStr);
  208.         aNum2Str := NumStr;
  209.     end;
  210.  
  211.  
  212.     function aStr2Num;{(NumStr: Str255): LongInt}
  213.         var
  214.             aNum: LongInt;
  215.     begin
  216.         StringToNum(NumStr, aNum);
  217.         aStr2Num := aNum
  218.     end;
  219.  
  220.  
  221.     procedure Replace;{(var strvar :  Str255; oldstr,newstr : Str255)}
  222.         var
  223.             location: Integer;
  224.     begin
  225.         location := Pos(oldstr, strvar);
  226.         if location > 0 then
  227.             begin
  228.                 Delete(strvar, location, Length(oldstr));
  229.                 if Length(newstr) > 0 then
  230.                     Insert(newstr, strvar, location);
  231.             end;
  232.     end; { of proc Replace }
  233.  
  234.  
  235.     procedure ReplaceAll;{(var strvar :  Str255; oldstr,newstr : Str255)}
  236.         var
  237.             location: Integer;
  238.     begin
  239.         location := Pos(oldstr, strvar);
  240.         while location > 0 do
  241.             begin
  242.                 Delete(strvar, location, Length(oldstr));
  243.                 if Length(newstr) > 0 then
  244.                     Insert(newstr, strvar, location);
  245.                 location := Pos(oldstr, strvar);
  246.             end;
  247.     end; { of proc ReplaceAll }
  248.  
  249.  
  250.     procedure Lower;{(var strvar : str255)}
  251.         var
  252.             i: Integer;
  253.             LowDiacrits, UprDiacrits: string[29];
  254.     begin
  255.         LowDiacrits := 'èîêïëç╛ìæÅÉÄòôöÆû╧Üÿ¢Öùƒ¥₧£╪┐';
  256.         UprDiacrits := 'Çü╦╠στ«éΦΘµâ∞φδΩä╬à±═∩εå⌠≤≥┘»';
  257.         for i := 1 to Length(strvar) do
  258.             if (strvar[i] >= 'A') and (strvar[i] <= 'Z') then  { "normal" upper case }
  259.                 strvar[i] := Chr(Ord(strvar[i]) + 32)
  260.             else if Pos(strvar[i], UprDiacrits) > 0 then { upper case diacriticals }
  261.                 strvar[i] := LowDiacrits[Pos(strvar[i], UprDiacrits)]
  262.     end; { of proc Lower }
  263.  
  264.  
  265.     procedure CapitalizeWords; {(var strvar: str255)}
  266.         var
  267.             C: Str255;
  268.             i: Integer;
  269.             CapNextWord: Boolean;             { capitalize next word marker }
  270.     begin
  271.         CapNextWord := True;
  272.         for i := 1 to Length(strvar) do
  273.             begin
  274.                 if (Ord(strvar[i]) in [0..32]) then            { word breaks }
  275.                     CapNextWord := True;
  276.                 if CapNextWord and not (strvar[i] in [' ', chr(9), chr(39), '(', '[', '╥', '╘', '"']) then
  277.                     begin
  278.                         C := strvar[i];
  279.                         UprString(C, True);        { use toolbox to capitalize beginning of next line }
  280.                         strvar[i] := C[1];
  281.                         CapNextWord := False;    { reset capitalize next word var }
  282.                     end;
  283.             end;
  284.     end; { of proc CapitalizeWords }
  285.  
  286.  
  287.  
  288.  
  289. end.